Admin

Run scripts and load objects

source("~scripts/00 - Admin.R") 
source("~scripts/01 - Utility Functions.R")
source("~scripts/10 - Read Siegel Data.R")
guns_df <- readRDS("~outputs/10/11_guns_df.rds")
guns_clean <- readRDS("~outputs/20/21_guns_clean.rds")
guns_list <- readRDS("~outputs/20/21_guns_list.rds")
siegelSum <- readRDS("~outputs/20/20_siegelSum.RDS")
guns_list_shp <- readRDS("~outputs/20/21_guns_list_shp.rds")
guns_list_shp_byYear <- readRDS("~outputs/20/21_guns_list_shp_byYear.rds")
source("~scripts/31 - Explore crime data.R")
tracts_crimeCounts <- readRDS("~outputs/30/33_tracts_crimeCounts.rds")
BGs_crimeCounts <- readRDS("~outputs/30/33_BGs_crimeCounts.rds")
BG_selection_list <- readRDS("~outputs/20/22_BG_selection_list.rds")
tract_selection_list <- readRDS("~outputs/20/22_tract_selection_list.rds")

Explore Data

Siegel

Date range: 1991-2019

range(siegel_raw$year)
## [1] 1991 2019

134 different laws…

unique(siegel_raw$law)
##   [1] age18longgunpossess          age18longgunsale            
##   [3] age21handgunpossess          age21handgunsale            
##   [5] age21longgunpossess          age21longgunsale            
##   [7] age21longgunsaled            alcoholism                  
##   [9] alctreatment                 amm18                       
##  [11] amm21h                       ammbackground               
##  [13] ammlicense                   ammpermit                   
##  [15] ammrecords                   ammrestrict                 
##  [17] assault                      assaultlist                 
##  [19] assaultregister              assaulttransfer             
##  [21] backgroundpurge              cap14                       
##  [23] cap16                        cap18                       
##  [25] capaccess                    capliability                
##  [27] capunloaded                  capuses                     
##  [29] ccbackground                 ccbackgroundnics            
##  [31] ccrenewbackground            ccrevoke                    
##  [33] college                      collegeconcealed            
##  [35] danger                       dealer                      
##  [37] dealerh                      defactoreg                  
##  [39] defactoregh                  drugmisdemeanor             
##  [41] dvro                         dvrodating                  
##  [43] dvroremoval                  dvrosurrender               
##  [45] dvrosurrenderdating          dvrosurrendernoconditions   
##  [47] elementary                   exparte                     
##  [49] expartedating                expartesurrender            
##  [51] expartesurrenderdating       expartesurrendernoconditions
##  [53] felony                       fingerprint                 
##  [55] gunshow                      gunshowh                    
##  [57] gvro                         gvrolawenforcement          
##  [59] immunity                     incidentall                 
##  [61] incidentremoval              inspection                  
##  [63] invcommitment                invoutpatient               
##  [65] junkgun                      liability                   
##  [67] lockd                        locked                      
##  [69] lockp                        lockstandards               
##  [71] loststolen                   magazine                    
##  [73] magazinepreowned             mayissue                    
##  [75] mcdv                         mcdvdating                  
##  [77] mcdvremovalallowed           mcdvremovalrequired         
##  [79] mcdvsurrender                mcdvsurrenderdating         
##  [81] mcdvsurrendernoconditions    mentalhealth                
##  [83] microstamp                   nosyg                       
##  [85] onefeature                   onepermonth                 
##  [87] opencarryh                   opencarryl                  
##  [89] opencarrypermith             opencarrypermitl            
##  [91] permit                       permitconcealed             
##  [93] permith                      permitlaw                   
##  [95] personalized                 preemption                  
##  [97] preemptionbroad              preemptionnarrow            
##  [99] purge                        recordsall                  
## [101] recordsallh                  recordsdealer               
## [103] recordsdealerh               registration                
## [105] registrationh                relinquishment              
## [107] reportall                    reportallh                  
## [109] reportdealer                 reportdealerh               
## [111] residential                  security                    
## [113] showing                      stalking                    
## [115] statechecks                  statechecksh                
## [117] strawpurchase                strawpurchaseh              
## [119] tenroundlimit                theft                       
## [121] threedaylimit                traffickingbackground       
## [123] traffickingprohibited        traffickingprohibitedh      
## [125] training                     universal                   
## [127] universalh                   universalpermit             
## [129] universalpermith             violent                     
## [131] violenth                     violentpartial              
## [133] waiting                      waitingh                    
## 134 Levels: age18longgunpossess age18longgunsale ... waitingh

Organized into 14 categories…

unique(siegel_raw$Category)
##  [1] possession.regulations                      
##  [2] buyer.regulations                           
##  [3] prohibitions.for.high-risk.gun.possession   
##  [4] ammunition.regulations                      
##  [5] assault.weapons.and.large-capacity.magazines
##  [6] background.checks                           
##  [7] child.access.prevention                     
##  [8] concealed.carry.permitting                  
##  [9] dealer.regulations                          
## [10] domestic.violence                           
## [11] immunity                                    
## [12] gun.trafficking                             
## [13] stand.your.ground                           
## [14] preemption                                  
## 14 Levels: ammunition.regulations ...

And 50 sub-categories

unique(siegel_raw$Sub.Category)
##  [1] Age restrictions                         
##  [2] Alcohol                                  
##  [3] Background checks                        
##  [4] Licensing                                
##  [5] Permitting                               
##  [6] Recordkeeping                            
##  [7] Prohibitors                              
##  [8] Assault weapons ban                      
##  [9] Background check records                 
## [10] Storage                                  
## [11] Campus carry                             
## [12] Mental Health                            
## [13] Registration                             
## [14] Drugs                                    
## [15] Restraining order                        
## [16] School zones                             
## [17] Felony                                   
## [18] Fingerprinting                           
## [19] Gun shows                                
## [20] Gun violence restraining orders          
## [21] Immunity                                 
## [22] Firearm removal                          
## [23] Inspections                              
## [24] Junk guns                                
## [25] Liability                                
## [26] Safety locks                             
## [27] Theft reporting                          
## [28] Large capacity magazine ban              
## [29] Misdemeanor crimes                       
## [30] Background checks - mental health records
## [31] Crime gun identification                 
## [32] Stand your ground                        
## [33] Bulk purchase limit                      
## [34] Open carry                               
## [35] Personalized gun technology              
## [36] Preemption                               
## [37] Reporting                                
## [38] Relinquishment of weapons                
## [39] Location                                 
## [40] Security                                 
## [41] Stalking                                 
## [42] Background checks - state records        
## [43] Straw purchase                           
## [44] Background checks time limit             
## [45] Gun trafficking                          
## [46] Safety training                          
## [47] Universal background checks              
## [48] Background checks through permits        
## [49] Violent Misdemeanor                      
## [50] Waiting period                           
## 50 Levels: Age restrictions Alcohol ... Waiting period

Scores over time

ggplot(siegelSum,
       aes(x = year,
           y = score)) +
  geom_line(size = 1) +
  # geom_point() +
  facet_wrap(~ state, ncol = 5, scales = "free_x") +
  plotTheme() +
  scale_x_continuous(breaks = seq(min(siegelSum$year), max(siegelSum$year), 5)) +
  labs(title = "Siegel Scores",
       x = "Year",
       y = "Score (sum of gun laws)") +
  theme(panel.spacing.x = unit(8, "mm"))

Gun Crimes

Number of Cities: 34 Number of States: 29

unique(guns_clean$city)
##  [1] "Atlanta"           "Auburn"            "Baltimore"        
##  [4] "Baton Rouge"       "Boston"            "Chicago"          
##  [7] "Cincinnati"        "Columbia"          "Dallas"           
## [10] "Denver"            "Detroit"           "Gainesville"      
## [13] "Hartford"          "Indianapolis"      "Kansas City"      
## [16] "Lincoln"           "Little Rock"       "Los Angeles"      
## [19] "Louisville"        "Madison"           "Minneapolis"      
## [22] "Nashville"         "New York"          "Philadelphia"     
## [25] "Phoenix"           "Portland"          "Raleigh"          
## [28] "Sacramento County" "Saint Paul"        "Salt Lake City"   
## [31] "San Francisco"     "St Louis County"   "Tucson"           
## [34] "Virginia Beach"
unique(guns_clean$state)
##  [1] "Georgia"        "Washington"     "Maryland"       "Louisiana"     
##  [5] "Massachusetts"  "Illinois"       "Ohio"           "South Carolina"
##  [9] "Texas"          "Colorado"       "Michigan"       "Florida"       
## [13] "Connecticut"    "Indiana"        "Missouri"       "Nebraska"      
## [17] "Arkansas"       "California"     "Kentucky"       "Wisconsin"     
## [21] "Minnesota"      "Tennessee"      "New York"       "Pennsylvania"  
## [25] "Arizona"        "Oregon"         "North Carolina" "Utah"          
## [29] "Virginia"

Date Range:

  • Occurrence Date: 06/19/1922 - 05/01/2020
  • Report Date: 10/03/1960 - 05/01/2020
plan(multiprocess)
guns_sample_ls <- future_map(guns_sample_ls,
                        ~ .x %>% 
                          mutate(clean_occur_date = anydate(occurdate), # use built-in formats from anytime package
         # correct some incorrectly parsed observations
         clean_occur_date = case_when(occurdate == "1" ~ as.Date(NA),
                                      clean_occur_date < as.Date("1900-01-01") ~ as.Date(NA), 
                                      is.na(clean_occur_date) & 
                                        str_detect(occurdate,
                                                   ".*\\d+/\\d+/\\d+.*") ~ # e.g "12/3/15", "12/3/15 1600" 
                                        as.Date(occurdate, "%m/%d/%y"),
                                      TRUE ~ clean_occur_date),
         clean_report_date = anydate(reportdate),
         clean_report_date = case_when(reportdate == "1" ~ as.Date(NA),
                                       clean_report_date < as.Date("1900-01-01") ~ as.Date(NA),
                                       is.na(clean_report_date) & 
                                        str_detect(reportdate,
                                                   ".*\\d+/\\d+/\\d+.*") ~ # e.g "12/3/15", "12/3/15 1600" 
                                        as.Date(reportdate, "%m/%d/%y"),
                                      TRUE ~ clean_report_date)))
range(guns_clean$clean_occur_date, na.rm = TRUE)
## [1] "2001-01-01" "2020-05-01"
range(guns_clean$clean_report_date, na.rm = TRUE)
## [1] "1922-06-19" "2020-05-01"

Plots

Crime counts by city

gunIncident_summary %>% 
  arrange(desc(prop)) %>% 
  kable() %>% 
  kable_styling()
city gun_count all_crimes_count prop
Los Angeles 696998 2114091 0.3296916
Madison 3862 12991 0.2972827
St Louis County 6817 65111 0.1046981
Baltimore 30264 300336 0.1007671
Philadelphia 261276 2747086 0.0951102
Nashville 90721 1088679 0.0833313
Chicago 535385 7105053 0.0753527
Detroit 58523 872947 0.0670407
Baton Rouge 26035 456033 0.0570902
Indianapolis 34232 750728 0.0455984
Hartford 25551 668332 0.0382310
Saint Paul 9058 248359 0.0364714
Sacramento County 12874 362005 0.0355630
Raleigh 24617 719797 0.0341999
Minneapolis 7068 217760 0.0324578
Columbia 793 25459 0.0311481
San Francisco 72643 2546472 0.0285269
Virginia Beach 3047 124693 0.0244360
New York 156048 6847944 0.0227876
Louisville 29410 1330690 0.0221013
Denver 9878 563795 0.0175206
Kansas City 36809 2143395 0.0171732
Boston 10910 746868 0.0146077
Lincoln 3381 241098 0.0140233
Tucson 22656 1828868 0.0123880
Portland 2064 214817 0.0096082
Cincinnati 3505 395676 0.0088583
Auburn 195 22383 0.0087120
Dallas 9337 1089765 0.0085679
Gainesville 1319 157253 0.0083878
Salt Lake City 4746 793509 0.0059810
Atlanta 1006 349277 0.0028802
Little Rock 214 86909 0.0024623
Phoenix 570 294292 0.0019369
gunIncidentsByCityPlot <- readRDS("~outputs/30/31c_gunIncidentsByCityPlot.rds")
gunIncidentsByCityPlot

How many NA observations?

na_coords_summary <- map(guns_list,
                            ~ sum(is.na(.x$lon) | is.na(.x$lat)) /
                              nrow(.x)) %>% 
  bind_rows() %>% 
  gather(key = "City",
         value = "pct_NA")
na_coords_summary %>% 
  arrange(desc(pct_NA)) %>% 
  kable() %>% 
  kable_styling()
City pct_NA
Portland 0.1254845
Boston 0.0574702
Kansas City 0.0491456
Baton Rouge 0.0464759
Dallas 0.0391989
Sacramento County 0.0347988
New York 0.0317274
Raleigh 0.0298574
Lincoln 0.0239574
St Louis County 0.0237641
Cincinnati 0.0208274
Auburn 0.0205128
Little Rock 0.0186916
Nashville 0.0185845
Salt Lake City 0.0179098
Philadelphia 0.0106018
Gainesville 0.0068234
Tucson 0.0066649
Louisville 0.0054743
Chicago 0.0050338
Baltimore 0.0047251
Minneapolis 0.0025467
Saint Paul 0.0022080
San Francisco 0.0018446
Detroit 0.0016916
Madison 0.0012947
Indianapolis 0.0009932
Virginia Beach 0.0009846
Denver 0.0008099
Los Angeles 0.0004548
Atlanta 0.0000000
Columbia 0.0000000
Hartford 0.0000000
Phoenix 0.0000000

All Cities

Maps of each city
Atlanta

Auburn

Baltimore

Baton Rouge

Boston

Chicago

Cincinnati

Columbia

Dallas

Denver

Detroit

Gainesville

Hartford

Indianapolis

Kansas City

Lincoln

Little Rock

Los Angeles

Louisville

Madison

Minneapolis

Nashville

New York

Philadelphia

Phoenix

Portland

Raleigh

Sacramento County

Saint Paul

Salt Lake City

San Francisco

St Louis County

Tucson

Virginia Beach

Moran’s I

What is Moran’s I?

Inferential statistic ranging from -1 to 1 that describes the level of dispersal/clustering evident in spatial data. Associated with a p-value that provides the statistical significance of the estimate.

Moran’s I range

That assumes a uniform intensity to all values. We need to choose some value for determining an “intensity” for the areas. For now, I went with “gun crimes per 100 people”. Is there another metric that might be better?

Read in the study area geographies w/ crimes per 100, raw crime counts, and population per tract.

Another question is the geographic scope we look at. Some choices. I looked at Census-designated place for now, because those generally align with published city borders.

A concave or convex hull may better fit the data, though.

  • Tracts selected via:
    • Concave hull of gun crime observations
    • Convex hull of gun crime observations
    • All tracts in any county with at least 1 gun crime observation
    • Census-designated places matching the city/county name
  • Block Groups selected via the same criteria
# source("~scripts/33 - Aggregate crimes and geographies.R") 
# tracts_crimeCounts <- readRDS("~outputs/30/33_tracts_crimeCounts.rds")
# BGs_crimeCounts <- readRDS("~outputs/30/33_BGs_crimeCounts.rds")
tmap::tmap_mode("view")

tmap::qtm(tracts_crimeCounts$byCaveHull$`San Francisco`, title = "Concave hull of crimes")
tmap::qtm(tracts_crimeCounts$byVexHull$`San Francisco`, title = "Convex hull of crimes")
tmap::qtm(tracts_crimeCounts$byCounty$`San Francisco`, title = "County")
tmap::qtm(tracts_crimeCounts$byPlace$`San Francisco`, title = "Census-designated place")
# source("~scripts/34 - Calculate Moran's I.R")  
tracts_I <- readRDS("~outputs/30/34_tracts_I.rds")
BGs_I <- readRDS("~outputs/30/34_BGs_I.rds")
tracts_pop_I <- readRDS("~outputs/30/34_tracts_pop_I.rds")
BGs_pop_I <- readRDS("~outputs/30/34_BGs_pop_I.rds")
tracts_per100_I <- readRDS("~outputs/30/34_tracts_per100_I.rds")
BGs_per100_I <- readRDS("~outputs/30/34_BGs_per100_I.rds")
# crime Moran's I tract
I_crime_tr <- map_dfr(tracts_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(crime_I = `Moran I statistic`)

p_crime_tr <- map_dfr(tracts_I$byPlace,
                     ~ data.frame(pval_crime = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Tract",
         pval_crime = ifelse(pval_crime < 0.01, "< 0.01", "> 0.01"))

# crime Moran's I block group
I_crime_BG <- map_dfr(BGs_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(crime_I = `Moran I statistic`)

p_crime_BG <- map_dfr(BGs_I$byPlace,
                     ~ data.frame(pval_crime = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Block Group",
         pval_crime = ifelse(pval_crime < 0.01, "< 0.01", "> 0.01"))

# pop Moran's I tract
I_pop_tr <- map_dfr(tracts_pop_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(pop_I = `Moran I statistic`)

p_pop_tr <- map_dfr(tracts_pop_I$byPlace,
                     ~ data.frame(pval_pop = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Tract",
         pval_pop = ifelse(pval_pop < 0.01, "< 0.01", "> 0.01"))

# pop Moran's I block group
I_pop_BG <- map_dfr(BGs_pop_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(pop_I = `Moran I statistic`)

p_pop_BG <- map_dfr(BGs_pop_I$byPlace,
                     ~ data.frame(pval_pop = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Block Group",
         pval_pop = ifelse(pval_pop < 0.01, "< 0.01", "> 0.01"))

# per100 Moran's I tract
I_per100_tr <- map_dfr(tracts_per100_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(per100_I = `Moran I statistic`)

p_per100_tr <- map_dfr(tracts_per100_I$byPlace,
                     ~ data.frame(pval_per100 = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Tract",
         pval_per100 = ifelse(pval_per100 < 0.01, "< 0.01", "> 0.01"))

# per100 Moran's I block group
I_per100_BG <- map_dfr(BGs_per100_I$byPlace,
                     ~ .x$estimate[1],
                     .id = "City") %>% 
  rename(per100_I = `Moran I statistic`)

p_per100_BG <- map_dfr(BGs_per100_I$byPlace,
                     ~ data.frame(pval_per100 = .x$p.value),
                     .id = "City") %>% 
  mutate(geo = "Block Group",
         pval_per100 = ifelse(pval_per100 < 0.01, "< 0.01", "> 0.01"))



I_crime_tmp <- left_join(I_crime_tr, p_crime_tr,
                   by = "City") %>% 
  rbind(left_join(I_crime_BG, p_crime_BG, 
                  by = "City"))
I_pop_tmp <- left_join(I_pop_tr, p_pop_tr,
                  by = "City") %>% 
  rbind(left_join(I_pop_BG, p_pop_BG,
                  by = "City"))
I_per100_tmp <- left_join(I_per100_tr, p_per100_tr,
                  by = "City") %>% 
  rbind(left_join(I_per100_BG, p_per100_BG,
                  by = "City"))
I_tmp <- left_join(I_crime_tmp, I_pop_tmp, by = c("City", "geo")) %>% 
  left_join(I_per100_tmp, by = c("City", "geo"))

I_wide <- I_tmp %>% 
  pivot_wider(names_from = "geo",
              values_from = c("crime_I", "pop_I", "pval_crime", "pval_pop", "per100_I", "pval_per100")) %>% 
  dplyr::select(City, 
                per100_tr = per100_I_Tract,
                per100_tr_p = pval_per100_Tract,
                crime_tr = crime_I_Tract,
                crime_tr_p = pval_crime_Tract,
                pop_tr = pop_I_Tract,
                pop_tr_p = pval_pop_Tract,
                per100_BG = `per100_I_Block Group`,
                per100_BG_p = `pval_per100_Block Group`,
                crime_BG = `crime_I_Block Group`,
                crime_BG_p = `pval_crime_Block Group`,
                pop_BG = `pop_I_Block Group`,
                pop_BG_p = `pval_pop_Block Group`) 

Below is a table showing Moran’s I for crimes per 100 for census tracts and block groups for each study area selected by the relevant Census-designated place, raw crime counts, and population. We see a big range from 0 (essentially random gun crime distribution relative to population) to very high

I_wide %>%  
  mutate(crime_tr_p = cell_spec(crime_tr_p,
                           "html",
                           background = ifelse(str_detect(crime_tr_p, ">"),
                             "red", 
                             "white")),
         pop_tr_p = cell_spec(pop_tr_p,
                           "html",
                           background = ifelse(str_detect(pop_tr_p, ">"),
                             "red", 
                             "white")),
         per100_tr_p = cell_spec(per100_tr_p,
                           "html",
                           background = ifelse(str_detect(per100_tr_p, ">"),
                             "red", 
                             "white")),
         crime_BG_p = cell_spec(crime_BG_p,
                           "html",
                           background = ifelse(str_detect(crime_BG_p, ">"),
                             "red", 
                             "white")),
         pop_BG_p = cell_spec(pop_BG_p,
                           "html",
                           background = ifelse(str_detect(pop_BG_p, ">"),
                             "red", 
                             "white")),
         per100_BG_p = cell_spec(per100_BG_p,
                           "html",
                           background = ifelse(str_detect(per100_BG_p, ">"),
                             "red", 
                             "white"))) %>% 
  arrange(desc(per100_tr)) %>%
  kable(format = "html",
        escape = FALSE,
        digits = 2,
        caption = "Moran's I for Crimes per 100 people, Crime Count, and Population by Tract and Block Group") %>%
  kable_styling(bootstrap_options = "striped")
Moran’s I for Crimes per 100 people, Crime Count, and Population by Tract and Block Group
City per100_tr per100_tr_p crime_tr crime_tr_p pop_tr pop_tr_p per100_BG per100_BG_p crime_BG crime_BG_p pop_BG pop_BG_p
Chicago 0.70 < 0.01 0.56 < 0.01 0.31 < 0.01 0.67 < 0.01 0.52 < 0.01 0.25 < 0.01
Indianapolis 0.66 < 0.01 0.55 < 0.01 0.33 < 0.01 0.65 < 0.01 0.48 < 0.01 0.32 < 0.01
St Louis County 0.60 < 0.01 0.58 < 0.01 0.17 < 0.01 0.57 < 0.01 0.60 < 0.01 0.27 < 0.01
Louisville 0.60 < 0.01 0.53 < 0.01 0.22 < 0.01 0.54 < 0.01 0.53 < 0.01 0.06 > 0.01
Boston 0.59 < 0.01 0.54 < 0.01 0.04 > 0.01 0.45 < 0.01 0.49 < 0.01 0.05 > 0.01
Philadelphia 0.58 < 0.01 0.61 < 0.01 0.24 < 0.01 0.48 < 0.01 0.43 < 0.01 0.17 < 0.01
Tucson 0.58 < 0.01 0.55 < 0.01 0.12 < 0.01 0.33 < 0.01 0.41 < 0.01 0.30 < 0.01
Sacramento County 0.56 < 0.01 0.56 < 0.01 0.19 < 0.01 0.56 < 0.01 0.57 < 0.01 0.23 < 0.01
Lincoln 0.56 < 0.01 0.51 < 0.01 -0.03 > 0.01 0.51 < 0.01 0.39 < 0.01 0.35 < 0.01
Baton Rouge 0.54 < 0.01 0.38 < 0.01 0.22 < 0.01 0.51 < 0.01 0.49 < 0.01 0.23 < 0.01
Raleigh 0.53 < 0.01 0.68 < 0.01 0.40 < 0.01 0.52 < 0.01 0.56 < 0.01 0.26 < 0.01
Denver 0.53 < 0.01 0.50 < 0.01 0.18 < 0.01 0.61 < 0.01 0.37 < 0.01 0.20 < 0.01
Saint Paul 0.50 < 0.01 0.46 < 0.01 0.30 < 0.01 0.55 < 0.01 0.49 < 0.01 0.16 < 0.01
Dallas 0.50 < 0.01 0.38 < 0.01 0.29 < 0.01 0.32 < 0.01 0.24 < 0.01 0.24 < 0.01
Nashville 0.49 < 0.01 0.43 < 0.01 0.22 < 0.01 0.26 < 0.01 0.34 < 0.01 0.29 < 0.01
Minneapolis 0.49 < 0.01 0.43 < 0.01 0.19 < 0.01 0.58 < 0.01 0.40 < 0.01 0.25 < 0.01
Little Rock 0.48 < 0.01 0.43 < 0.01 0.19 < 0.01 0.30 < 0.01 0.30 < 0.01 0.29 < 0.01
Baltimore 0.48 < 0.01 0.29 < 0.01 0.29 < 0.01 0.35 < 0.01 0.35 < 0.01 0.17 < 0.01
Atlanta 0.47 < 0.01 0.43 < 0.01 0.26 < 0.01 0.42 < 0.01 0.41 < 0.01 0.19 < 0.01
Hartford 0.44 < 0.01 0.27 < 0.01 0.30 < 0.01 0.42 < 0.01 0.44 < 0.01 0.15 < 0.01
Salt Lake City 0.42 < 0.01 0.14 < 0.01 0.15 > 0.01 0.44 < 0.01 0.09 < 0.01 0.16 < 0.01
Columbia 0.41 < 0.01 0.34 < 0.01 0.22 < 0.01 0.35 < 0.01 0.28 < 0.01 0.17 < 0.01
Portland 0.38 < 0.01 0.33 < 0.01 0.25 < 0.01 0.33 < 0.01 0.38 < 0.01 0.34 < 0.01
Los Angeles 0.37 < 0.01 0.50 < 0.01 0.13 < 0.01 0.31 < 0.01 0.39 < 0.01 0.18 < 0.01
Virginia Beach 0.34 < 0.01 0.26 < 0.01 0.05 > 0.01 0.18 < 0.01 0.25 < 0.01 0.15 < 0.01
New York 0.30 < 0.01 0.45 < 0.01 0.30 < 0.01 0.34 < 0.01 0.28 < 0.01 0.15 < 0.01
Phoenix 0.29 < 0.01 0.27 < 0.01 0.22 < 0.01 0.17 < 0.01 0.20 < 0.01 0.27 < 0.01
Madison 0.28 < 0.01 0.16 < 0.01 0.20 < 0.01 0.28 < 0.01 0.21 < 0.01 0.15 < 0.01
Detroit 0.27 < 0.01 0.35 < 0.01 0.34 < 0.01 0.19 < 0.01 0.23 < 0.01 0.27 < 0.01
Auburn 0.25 > 0.01 0.15 > 0.01 -0.11 > 0.01 0.29 < 0.01 0.31 < 0.01 -0.03 > 0.01
Gainesville 0.24 < 0.01 0.36 < 0.01 0.01 > 0.01 0.31 < 0.01 0.33 < 0.01 0.02 > 0.01
Cincinnati 0.20 < 0.01 0.14 < 0.01 0.29 < 0.01 0.29 < 0.01 0.10 < 0.01 0.14 < 0.01
San Francisco 0.15 < 0.01 0.46 < 0.01 0.10 < 0.01 0.41 < 0.01 0.58 < 0.01 0.04 > 0.01
Crimes by block group for each city
Atlanta

Auburn

Baltimore

Baton Rouge

Boston

Chicago

Cincinnati

Columbia

Dallas

Denver

Detroit

Gainesville

Hartford

Indianapolis

Kansas City

Lincoln

Little Rock

Los Angeles

Louisville

Madison

Minneapolis

Nashville

New York

Philadelphia

Phoenix

Portland

Raleigh

Sacramento County

Saint Paul

Salt Lake City

San Francisco

St Louis County

Tucson

Virginia Beach

Siegel Scores, Gun Crime Count, and Moran’s I by Year

The plots below show the Moran’s I (extent of spatial clustering), count of gun crimes, percentage of all crimes that are gun crimes, and Siegel Score for every city by year. The x-axis is aligned on each, so you can read straight down, but some of the cities with fewer years of data will look compressed horizontally.

A note on outliers: I noticed last time that several cities (NYC, LA, SF, others) had Moran’s Is of around 0, and this persisted even when looking at them year-by-year, despite visual evidence in the maps showing clear clustering (see map of San Francisco above, for example). This was due to outliers in the gun crimes / 100 stat (a few gun crimes in an area with low population lead to extremely high values). So, I filtered out the block groups every year that had values higher than the 99.5th percentile in each city. In LA, this had the effect of changing the Moran’s I from 0 to around 0.55, a much more sensible value. The 99.5th percentile cut-off is arbitrary. Also, those block groups were filtered out rather than imputed, so they would be empty on a map.

  • Boston: Total gun crimes and clustering dropped over the last decade.

  • Chicago: clustering is steady over time, while total gun crimes have decreased. Siegel score has steadily risen since 1991.

  • Denver: Gun crimes and clustering seem to have increased. Crime data available from 2014.

  • Detroit: Decrease in gun crimes and clustering. Steady Siegel Score.

  • Hartford: Clustering has dipped, while both annual gun crimes and Siegel Score have risen.

  • Indianapolis: Gradual decline in clustering. Sudden drop in gun crimes (reporting change?). Little change to Siegel Score.

  • Los Angeles: Rising Siegel Score, little change to overall crimes or clustering.

  • Louisville: Sharp increase in crimes, little change to clustering and Siegel.

  • Minneapolis: Decrease in clustering, increase in crimes and Siegel Score.

  • Nashville: Decrease in clustering, increase in crimes.

  • New York: Decrease in crimes and increase in Siegel Score. Not change to clustering.

  • Philly: Decrease in crimes, maybe a slight increase in clustering, little change to Siegel Score.

  • Portland: Limited sample, but all three seem to have risen recently.

  • San Francisco: Increase in Siegel Score, but not much change to total crimes or clustering.

  • St. Louis County: Decrease in Siegel Score and increase in crimes.

  • Tucson: Decrease in crimes and clustering.

Atlanta

Auburn

Baltimore

Baton Rouge

Boston

Chicago

Cincinnati

Columbia

Dallas

Denver

Detroit

Gainesville

Hartford

Indianapolis

Kansas City

Lincoln

Little Rock

Los Angeles

Louisville

Madison

Minneapolis

Nashville

New York

Philadelphia

Phoenix

Portland

Raleigh

Sacramento County

Saint Paul

Salt Lake City

San Francisco

St Louis County

Tucson

Virginia Beach

Cluster / Outlier maps

These maps show high- and low-crime clusters (crimes per 100), as well as areas with high- or low-crime compared to their neighbors. Areas in white not shown to have a statistically significant relationship with their neighbors.

Notes:

  • I calculated this for every year as well, so we can see how clusters move, but not sure how to visualize it. A gif, maybe?

  • Next step is to compare demographics across the categories, or at least the hotspots vs. the whole city.

  • Intuitively, these maps make sense. At least for the cities I know, the hot spot locations are not surprising.

  • Generally, there are far more hotspots than there are cold spots. Makes sense, a long right tail for gun crimes per capita.

  • Some edge effects, it seems, particularly with the “low crime” areas. See Baltimore and Chicago for example. For spatial weights calculation, weights are standardized over all links to the block group, so block groups on the edge naturally have fewer neighbors that are weighed more highly.

  • Very few “outliers”, where the block group is very different from their neighbor.

Atlanta

Auburn

Baltimore

Baton Rouge

Boston

Chicago

Cincinnati

Columbia

Dallas

Denver

Detroit

Gainesville

Hartford

Indianapolis

Kansas City

Lincoln

Little Rock

Los Angeles

Louisville

Madison

Minneapolis

Nashville

New York

Philadelphia

Phoenix

Portland

Raleigh

Sacramento County

Saint Paul

Salt Lake City

San Francisco

St Louis County

Tucson

Virginia Beach

Hotspot demographic and socio-economic variables

BGs_per100_localI_census <- readRDS("~outputs/30/34_BGs_per100_localI_census.rds")

BGs_per100_localI_census_tmp <- map(
  BGs_per100_localI_census,
  ~ .x %>% 
    st_drop_geometry() %>% 
    mutate(hotspot = ifelse(str_detect(cluster, "high"),
                            "Yes",
                            "No"),
           majorityMinority_tmp = ifelse(majorityMinority == "Yes",
                                         1,
                                         0)) %>% 
    group_by(hotspot) %>% 
    summarize(Hotspots = n(),
              MdHHInc_weighted = round(weighted.mean(MdHHInc, TotPop, na.rm = TRUE), 0),
              Age_weighted = round(weighted.mean(MdAge, TotPop, na.rm = TRUE), 1),
              White_pct_weighted = round(weighted.mean(White_pct, TotPop, na.rm = TRUE), 2),
              Black_pct_weighted = round(weighted.mean(Black_pct, TotPop, na.rm = TRUE), 2),
              TotPop = sum(TotPop, na.rm = TRUE),
              .groups = "drop") %>% 
    arrange(desc(hotspot))) 
num_rows <- map(1:length(names(BGs_per100_localI_census_tmp)), 
                ~ nrow(BGs_per100_localI_census_tmp[[.x]])) %>% 
                  unlist() 

BGs_per100_localI_census_tmp %>%
  bind_rows() %>% 
  # arrange(Species)  %>%  # same order as table results  
  # select(-Species)  %>%
  kable("html",
        caption = "Weighted averages by Moran's I hotspots",
        # align = "",
        col.names = c("Hotspot?",
                      "# block groups",
                      "Med. HH Inc.",
                      "Med. Age",
                      "White %",
                      "Black %",
                      "Total Pop.")
        ) %>%
  kable_styling(full_width = F,
                fixed_thead = T) %>%
  group_rows(index = setNames(num_rows, names(BGs_per100_localI_census_tmp)),
             label_row_css = "background-color: #666; color: #fff;") 
Weighted averages by Moran’s I hotspots
Hotspot? # block groups Med. HH Inc.  Med. Age White % Black % Total Pop.
Atlanta
Yes 51 39698 35.2 0.19 0.76 55122
No 281 71100 35.5 0.43 0.49 456191
Auburn
Yes 6 48459 34.1 0.55 0.05 8082
No 47 80273 36.4 0.67 0.05 81083
Baltimore
Yes 135 77322 36.4 0.43 0.47 120267
No 518 52502 36.8 0.27 0.66 494433
Baton Rouge
Yes 33 37681 34.6 0.17 0.81 31524
No 188 57240 34.1 0.45 0.47 265448
Boston
Yes 93 41300 33.2 0.18 0.58 104270
No 467 78750 34.0 0.59 0.19 575143
Chicago
Yes 379 31197 35.6 0.08 0.86 332310
No 1809 66069 35.5 0.55 0.22 2401481
Cincinnati
Yes 37 46270 31.5 0.37 0.59 30777
No 260 47289 35.5 0.54 0.39 294029
Columbia
Yes 15 23326 32.4 0.06 0.90 16100
No 146 53314 33.6 0.50 0.42 207465
Dallas
Yes 99 43285 34.5 0.43 0.50 112063
No 873 63087 33.9 0.64 0.22 1325099
Denver
Yes 83 54732 31.9 0.72 0.13 117094
No 398 76546 36.2 0.77 0.09 576323
Detroit
Yes 81 43447 36.1 0.20 0.70 49983
No 798 32207 35.4 0.14 0.79 627172
Gainesville
Yes 8 30648 33.5 0.46 0.48 9963
No 95 44416 32.6 0.66 0.22 157091
Hartford
Yes 24 40970 34.7 0.30 0.45 28185
No 72 37683 32.4 0.34 0.35 95443
Indianapolis
Yes 161 60320 37.2 0.65 0.27 196949
No 436 50930 35.1 0.61 0.29 692428
Lincoln
Yes 41 66177 35.5 0.84 0.06 66895
No 150 65339 35.0 0.86 0.04 227681
Little Rock
Yes 16 31456 36.9 0.11 0.86 11367
No 142 62694 37.7 0.54 0.38 195075
Los Angeles
Yes 230 42359 34.1 0.36 0.24 321423
No 2284 68040 36.4 0.54 0.08 3644059
Louisville
Yes 47 41741 34.9 0.47 0.48 50009
No 223 46990 37.9 0.66 0.27 239247
Madison
Yes 26 72068 35.3 0.78 0.06 44842
No 154 67889 34.4 0.78 0.07 249411
Minneapolis
Yes 50 41905 29.0 0.29 0.44 55655
No 328 69843 34.1 0.69 0.16 360366
Nashville
Yes 34 45325 34.8 0.38 0.57 39657
No 429 64586 35.8 0.65 0.26 633184
New York
Yes 664 38283 33.5 0.18 0.44 808941
No 5780 72515 37.8 0.45 0.22 7634772
NA 3 NaN NaN NaN NaN 0
Philadelphia
Yes 328 48246 38.2 0.48 0.37 375273
No 1008 49113 34.8 0.39 0.44 1200249
Phoenix
Yes 61 35395 30.9 0.65 0.10 86118
No 916 63668 34.6 0.73 0.07 1561429
Portland
Yes 43 44274 37.1 0.66 0.08 71657
No 427 78454 38.4 0.79 0.05 634927
Raleigh
Yes 36 46167 33.9 0.38 0.50 59040
No 208 73996 35.6 0.62 0.25 467287
Sacramento County
Yes 128 43046 33.6 0.53 0.13 219082
No 784 75332 37.5 0.59 0.09 1290941
Saint Paul
Yes 75 64446 31.8 0.56 0.18 84414
No 175 56281 32.8 0.57 0.15 218346
Salt Lake City
Yes 18 40054 33.8 0.65 0.04 27342
No 133 70099 33.0 0.74 0.02 185408
San Francisco
Yes 49 57596 38.4 0.32 0.17 75151
No 530 117715 39.5 0.48 0.04 794893
NA 1 59063 26.2 0.39 0.20 3064
St Louis County
Yes 58 40575 35.2 0.18 0.78 74701
No 634 82581 41.5 0.72 0.20 923983
Tucson
Yes 77 60834 38.7 0.75 0.04 134939
No 331 45404 35.7 0.73 0.05 470850
Virginia Beach
Yes 22 53524 31.2 0.44 0.38 29167
No 280 82502 38.1 0.68 0.18 420968
Change in crimes over time
Atlanta

Auburn

Baltimore

Baton Rouge

Boston

Chicago

Cincinnati

Columbia

Dallas

Denver

Detroit

Gainesville

Hartford

Indianapolis

Kansas City

Lincoln

Little Rock

Los Angeles

Louisville

Madison

Minneapolis

Nashville

New York

Philadelphia

Phoenix

Portland

Raleigh

Sacramento County

Saint Paul

Salt Lake City

San Francisco

St Louis County

Tucson

Virginia Beach

Rise in gun crimes

BGs_crimeChange <- readRDS("~outputs/30/35_BGs_crimeChange.rds")

BGs_crimeChange_tmp <- map2(
  BGs_crimeChange,
  BGs_per100_localI_census,
  ~ .x %>% 
    left_join(.y,
              by = "GEOID") %>% 
    # st_drop_geometry() %>% 
    mutate(increase = ifelse(str_detect(CrimeIncrease, "No"),
                            "No",
                            CrimeIncrease),
           majorityMinority_tmp = ifelse(majorityMinority == "Yes",
                                         1,
                                         0)) %>% 
    group_by(increase) %>% 
    summarize(Increases = n(),
              MdHHInc_weighted = round(weighted.mean(MdHHInc, TotPop, na.rm = TRUE), 0),
              Age_weighted = round(weighted.mean(MdAge, TotPop, na.rm = TRUE), 1),
              White_pct_weighted = round(weighted.mean(White_pct, TotPop, na.rm = TRUE), 2),
              Black_pct_weighted = round(weighted.mean(Black_pct, TotPop, na.rm = TRUE), 2),
              TotPop = sum(TotPop, na.rm = TRUE),
              .groups = "drop") %>% 
    arrange(desc(increase))) 
num_rows <- map(1:length(names(BGs_crimeChange_tmp)), 
                ~ nrow(BGs_crimeChange_tmp[[.x]])) %>% 
                  unlist()

BGs_crimeChange_tmp %>% 
  bind_rows() %>% 
  # arrange(Species)  %>%  # same order as table results  
  # select(-Species)  %>%
  kable("html",
        caption = "Block groups where gun crimes increased",
        align = "l",
        col.names = c("Increase in gun crimes?",
                      "# block groups",
                      "Med. HH Inc.",
                      "Med. Age",
                      "White %",
                      "Black %",
                      "Total Pop.")
        ) %>%
  kable_styling(full_width = F) %>%
  group_rows(index = setNames(num_rows, names(BGs_per100_localI_census_tmp)),
             label_row_css = "background-color: #666; color: #fff;") 
Block groups where gun crimes increased
Increase in gun crimes? # block groups Med. HH Inc.  Med. Age White % Black % Total Pop.
Atlanta
Yes (significant) 5 66479 35.0 0.46 0.38 6493
Yes (not significant) 202 80464 36.0 0.50 0.41 321471
No 125 45442 34.6 0.23 0.72 183349
Auburn
Yes (not significant) 19 82543 35.8 0.63 0.04 30887
No 34 74657 36.4 0.68 0.05 58278
Baltimore
Yes (significant) 5 45887 38.2 0.27 0.49 4839
Yes (not significant) 265 63309 36.9 0.33 0.59 245050
No 383 53300 36.6 0.29 0.65 364811
Baton Rouge
Yes (significant) 6 62246 34.4 0.49 0.37 16704
Yes (not significant) 89 58377 34.2 0.49 0.43 117870
No 126 52177 34.1 0.36 0.57 162398
Boston
Yes (significant) 1 103750 29.6 0.92 0.00 1332
Yes (not significant) 66 93040 32.2 0.73 0.08 70253
No 493 70941 34.1 0.50 0.27 607828
Chicago
Yes (significant) 17 106915 34.0 0.62 0.13 38663
Yes (not significant) 195 73682 37.0 0.55 0.25 253668
No 1976 60031 35.4 0.49 0.31 2441460
Cincinnati
Yes (significant) 12 42250 34.1 0.38 0.57 11531
Yes (not significant) 140 48810 35.3 0.55 0.38 160679
No 145 45887 35.1 0.50 0.43 152596
Columbia
Yes (significant) 8 31473 28.7 0.27 0.67 7651
Yes (not significant) 120 53975 33.6 0.49 0.44 171924
No 33 43428 33.9 0.42 0.51 43990
Dallas
Yes (significant) 21 58017 34.3 0.64 0.26 29868
Yes (not significant) 577 66867 34.5 0.64 0.22 816856
No 374 54383 33.0 0.60 0.25 590438
Denver
Yes (significant) 10 68810 37.7 0.76 0.09 14456
Yes (not significant) 283 72717 35.3 0.76 0.10 423922
No 188 73628 35.6 0.77 0.09 255039
Detroit
No 879 33029 35.5 0.15 0.79 677155
Gainesville
Yes (significant) 1 NaN 33.3 0.34 0.61 1522
Yes (not significant) 39 43827 33.7 0.63 0.27 55928
No 63 43623 32.1 0.67 0.21 109604
Hartford
Yes (significant) 3 68621 32.8 0.51 0.18 2938
Yes (not significant) 43 39708 33.8 0.31 0.40 56237
No 50 35843 32.1 0.34 0.35 64453
Indianapolis
Yes (significant) 6 56391 32.7 0.27 0.60 10415
Yes (not significant) 78 51890 36.9 0.53 0.36 114013
No 513 53111 35.4 0.63 0.27 764949
Lincoln
Yes (significant) 4 74948 40.6 0.87 0.04 5745
Yes (not significant) 54 71671 36.0 0.89 0.03 81232
No 133 62911 34.6 0.84 0.05 207599
Little Rock
Yes (significant) 1 19044 31.3 0.26 0.64 490
Yes (not significant) 110 69348 38.0 0.57 0.35 148496
No 47 39776 36.6 0.37 0.56 57456
Los Angeles
Yes (significant) 458 61324 35.5 0.50 0.10 766809
Yes (not significant) 811 68945 36.6 0.53 0.09 1246504
No 1245 65997 36.2 0.53 0.08 1952169
Louisville
Yes (significant) 123 38320 35.4 0.52 0.43 137356
Yes (not significant) 121 48565 38.2 0.70 0.22 124929
No 26 73719 43.5 0.88 0.07 26971
Madison
Yes (significant) 20 61761 34.1 0.74 0.11 32442
Yes (not significant) 95 70353 34.9 0.78 0.07 153126
No 65 67916 34.1 0.80 0.04 108685
Minneapolis
Yes (significant) 9 47480 29.6 0.52 0.30 10975
Yes (not significant) 218 70486 34.1 0.69 0.15 236183
No 151 61490 32.7 0.57 0.25 168863
Nashville
Yes (significant) 3 97069 37.6 0.87 0.04 2620
Yes (not significant) 317 59196 34.9 0.61 0.30 486060
No 143 74217 37.7 0.70 0.22 184161
New York
Yes (significant) 45 64710 38.5 0.40 0.21 58515
Yes (not significant) 1874 79594 38.5 0.52 0.18 2141643
No 4528 65846 37.1 0.39 0.26 6243555
Philadelphia
Yes (significant) 3 72738 29.8 0.35 0.47 2516
Yes (not significant) 71 52000 37.7 0.46 0.40 84311
No 1262 48718 35.5 0.41 0.42 1488695
Phoenix
Yes (significant) 5 53477 31.4 0.58 0.12 8193
Yes (not significant) 708 67320 35.6 0.74 0.06 1150705
No 264 50315 31.5 0.68 0.09 488649
Portland
Yes (significant) 11 48400 39.9 0.76 0.09 18182
Yes (not significant) 304 81296 38.9 0.79 0.05 457310
No 155 64580 36.9 0.75 0.07 231092
Raleigh
Yes (significant) 2 62610 33.4 0.30 0.63 3658
Yes (not significant) 21 84266 36.8 0.56 0.34 52944
No 221 69336 35.3 0.60 0.27 469725
Sacramento County
Yes (significant) 17 79664 39.9 0.68 0.06 28124
Yes (not significant) 504 76151 37.5 0.56 0.10 820039
No 391 63629 36.1 0.60 0.10 661860
Saint Paul
Yes (not significant) 126 57782 33.2 0.57 0.16 154605
No 124 59316 31.8 0.56 0.16 148155
Salt Lake City
Yes (significant) 2 81667 38.0 0.93 0.00 2641
Yes (not significant) 40 66586 33.2 0.75 0.01 54750
No 109 66047 33.0 0.72 0.03 155359
San Francisco
Yes (significant) 26 128361 38.3 0.45 0.05 54814
Yes (not significant) 190 110665 39.2 0.47 0.05 290290
No 364 111939 39.6 0.46 0.06 528004
St Louis County
Yes (significant) 60 72769 40.0 0.64 0.28 82872
Yes (not significant) 511 83592 41.3 0.71 0.22 727910
No 121 66711 40.4 0.61 0.32 187902
Tucson
Yes (not significant) 32 70656 39.6 0.77 0.04 53773
No 376 46474 36.1 0.73 0.05 552016
Virginia Beach
Yes (significant) 4 96132 45.5 0.74 0.09 5808
Yes (not significant) 96 92126 38.9 0.72 0.15 133373
No 202 75448 36.9 0.64 0.21 310954